home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48_2
/
hprpldev.tar
/
scrsfky.s
< prev
next >
Wrap
Text File
|
1991-07-12
|
2KB
|
81 lines
*---------------------------------------------------------
*
* Include the header file KEYDEFS.H, which defines words
* like kcUpArrow at physical key numbers.
*
INCLUDE KEYDEFS.H
*
* Include the eight characters needed for binary download
*
ASSEMBLE
NIBASC /HPHP48-D/
RPL
*
* Begin the secondary
*
::
RECLAIMDISP ( *Claim the alpha display* )
ClrDA1IsStat ( *Temporarily disable clock* )
* ( *Try removing ClrDA1IsStat* )
ZEROZERO ( #0 #0 )
150 150 MAKEGROB ( #0 #0 150x150grob )
XYGROBDISP ( )
*
* Draw diagonal lines. Remember that LINEON requires
* requires #x2>#x1!
*
ZEROZERO ( #x1 #y1 )
149 149 ( #x1 #y1 #x2 #y2 )
LINEON ( *Draw line* )
ZERO 149 ( #x1 #y1 )
149 ZERO ( #x1 #y1 #x2 #y2 )
LINEON ( *Draw line* )
*
* Place text
*
HARDBUFF
75 50 "SCROLLING" ( HBgrob 75 150 "SCROLLING" )
150 CENTER$3x5 ( HBgrob )
75 100 "EXAMPLE" ( HBgrob 75 100 "EXAMPLE" )
150 CENTER$3x5 ( HBgrob )
DROPFALSE ( FALSE )
{ LAM Exit } BIND ( *Bind POL exit flag* )
' DispMenu.1
' :: ( *Hard key handler* )
kpNoShift #=casedrop
::
DUP#<7 casedrpfls ( *Enable softkeys* )
kcUpArrow ?CaseKeyDef
:: TakeOver SCROLLUP ;
kcLeftArrow ?CaseKeyDef
:: TakeOver SCROLLLEFT ;
kcDownArrow ?CaseKeyDef
:: TakeOver SCROLLDOWN ;
kcRightArrow ?CaseKeyDef
:: TakeOver SCROLLRIGHT ;
kcOn ?CaseKeyDef
:: TakeOver
TRUE ' LAM Exit STO ;
kcRightShift #=casedrpfls
DROP 'DoBadKeyT
;
2DROP 'DoBadKeyT
;
TrueTrue ( *Key control flags* )
{
{ "TOP" :: TakeOver JUMPTOP ; }
{ "BOT" :: TakeOver JUMPBOT ; }
{ "LEFT" :: TakeOver JUMPLEFT ; }
{ "RIGHT" :: TakeOver JUMPRIGHT ; }
NullMenuKey
{ "QUIT" :: TakeOver TRUE ' LAM Exit STO ; }
}
ONEFALSE ( *1st row, no suspend* )
' LAM Exit ( *App exit condition* )
' ERRJMP ( *Error handler* )
ParOuterLoop ( *Run the ParOuterLoop* )
RECLAIMDISP ( *Resize and clear display* )
ClrDAsOK ( *Redraw display* )
;